home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / search.tcl < prev    next >
Encoding:
Text File  |  1998-12-16  |  19.6 KB  |  686 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "search.tcl"
  6.  #                                    created: 13/6/95 {8:56:37 pm} 
  7.  #                                last update: 16/12/1998 {1:51:58 pm} 
  8.  #  
  9.  # Reorganisation carried out by Vince Darley with much help from Tom 
  10.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  11.  # Alpha is shareware; please register with the author using the register 
  12.  # button in the about box.
  13.  #  
  14.  #  Description: 
  15.  # 
  16.  # All procedures which deal with search/reg-search/grep type stuff
  17.  # in Alpha.
  18.  # ###################################################################
  19.  ##
  20.  
  21. namespace eval text {}
  22. namespace eval quote {}
  23. namespace eval file {}
  24.  
  25. proc quickFind {} {isearch}
  26. proc reverseQuickFind {} {rsearch}
  27. proc quickFindRegexp {} {regIsearch}
  28.  
  29. #================================================================================
  30. # 'greplist' and 'grepfset' are used for batch searching from the "find" dialog.
  31. #  Hence, you really shouldn't mess with them unless you know what you are doing.
  32. #================================================================================
  33. proc greplist {args} {
  34.     global tileLeft tileTop tileWidth tileHeight errorHeight
  35.     
  36.     set recurse [lindex $args 0]
  37.     set word [lindex $args 1]
  38.     set args [lrange $args 2 end]
  39.     
  40.     set num [expr {[llength $args] - 2}]
  41.     set exp [lindex $args $num]
  42.     set arglist [lindex $args [expr {$num + 1}]]
  43.     
  44.     set opened 0
  45.     set owin 0
  46.     set cid [scancontext create]
  47.     
  48.     set cmd [lrange $args 0 [expr {$num - 1}]]
  49.     eval scanmatch $cmd {$cid $exp {
  50.     if {!$word || [regexp -nocase -- "(^|\[^a-zA-Z0-9\])${exp}(\[^a-zA-Z0-9\]|\$)" $matchInfo(line)]} {
  51.         if (!$owin) {
  52.         set owin 1
  53.         win::SetProportions
  54.         set w [new -n {* Batch Find *} -m Brws -g $tileLeft $tileTop $tileWidth $errorHeight]
  55.         insertText "(<cr> to go to match)\r-----\r"
  56.         set opened 1
  57.         }
  58.         set l [expr 20 - [string length [file tail $f]]]
  59.         insertText -w $w "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): $matchInfo(line)\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"}
  60.     }
  61.     }
  62.     
  63.     foreach f $arglist {
  64.     message [file tail $f]
  65.     if {![catch {set fid [open $f]}]} {
  66.         scanfile $cid $fid
  67.         close $fid
  68.     }
  69.     }
  70.     scancontext delete $cid
  71.     
  72.     if {$opened} {
  73.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  74.     setWinInfo dirty 0
  75.     setWinInfo read-only 1
  76.     }
  77.     message ""
  78. }
  79.  
  80.  
  81. ## 
  82.  # -------------------------------------------------------------------------
  83.  # 
  84.  # "grepfset" --
  85.  # 
  86.  #  args: wordmatch ?-nocase? expression fileset
  87.  #  Obviously we ignore wordmatch
  88.  #  
  89.  #  If the 'Grep' box was set, then the search item is _not_ quoted.
  90.  #  
  91.  #  Non grep searching problems:
  92.  #  
  93.  #  If it wasn't set, then some backslash quoting takes place. 
  94.  #  (The chars: \.+*[]$^ are all quoted)
  95.  #  Unfortunately, this latter case is done incorrectly, so most
  96.  #  non-grep searches which contain a grep-sensitive character fail.
  97.  #  The quoting should use the equivalent of the procedure 'quote::Regfind'
  98.  #  but it doesn't quote () and perhaps other important characters.
  99.  #  
  100.  #  Even worse, if the string contained any '{' it never reaches this
  101.  #  procedure (there must be an internal error due to bad quoting).
  102.  # 
  103.  # -------------------------------------------------------------------------
  104.  ##
  105. proc grepfset {args} {
  106.     set num [expr {[llength $args] - 2}]
  107.     # the 'find' expression
  108.     set exp [lindex $args $num]
  109.     # the fileset
  110.     set fset [lindex $args [expr {$num + 1}]]
  111.     eval greplist 0 [lrange $args 0 [expr {$num-1}]] {$exp [getFileSet $fset]}
  112. }
  113.  
  114. proc grep {exp args} {
  115.     set files {}
  116.     foreach arg $args {
  117.     eval lappend files [glob -t TEXT -nocomplain $arg]
  118.     }
  119.     if {![llength $files]} {return "No files matched pattern"}
  120.     set cid [scancontext create]
  121.     scanmatch $cid $exp {
  122.     if {!$blah} {
  123.         set blah 1
  124.         set lines "(<cr> to go to match)\n"
  125.     }
  126.     set l [expr 20 - [string length [file tail $f]]]
  127.     append lines "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): $matchInfo(line)\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\n"
  128.     }
  129.     
  130.     set blah 0
  131.     set lines ""
  132.     
  133.     foreach f $files {
  134.     if {![catch {set fid [open $f]}]} {
  135.         message [file tail $f]
  136.         scanfile $cid $fid
  137.         close $fid
  138.     }
  139.     }
  140.     scancontext delete $cid
  141.     return [string trimright $lines "\r"]
  142. }
  143.  
  144. proc grepnames {exp args} {
  145.     set files {}
  146.     foreach arg $args {
  147.     eval lappend files [glob -t TEXT -nocomplain $arg]
  148.     }
  149.     if {![llength $files]} {return "No files matched pattern"}
  150.     set cid [scancontext create]
  151.     scanmatch $cid $exp {
  152.     lappend filenames $f
  153.     }
  154.     set filenames ""
  155.     foreach f $files {
  156.     if {![catch {set fid [open $f]}]} {
  157.         message [file tail $f]
  158.         scanfile $cid $fid
  159.         close $fid
  160.     }
  161.     }
  162.     scancontext delete $cid
  163.     return $filenames
  164. }
  165.  
  166. ## 
  167.  # -------------------------------------------------------------------------
  168.  # 
  169.  # "grepsToWindow" --
  170.  # 
  171.  #  'args' is a list of items
  172.  # -------------------------------------------------------------------------
  173.  ##
  174. proc grepsToWindow {title args} {
  175.     global tileLeft tileTop tileWidth tileHeight errorHeight
  176.     win::SetProportions
  177.     new -n $title -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  178.     eval insertText $args
  179.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  180.     winReadOnly
  181.     message ""
  182. }
  183.  
  184. proc findBatch {forward ignore regexp word pat} {
  185.     matchingLines $pat $forward $ignore $word $regexp 
  186. }
  187.  
  188. ## 
  189.  # -------------------------------------------------------------------------
  190.  #     
  191.  #    "containsSpace"    --
  192.  #    
  193.  #     Does the given    text contain any spaces?  In general we    don't complete
  194.  #     commands which    contain    spaces (although perhaps future    extensions
  195.  #     should    do this: e.g. cycle    through    'string    match',    'string    compare',…)
  196.  # -------------------------------------------------------------------------
  197.  ##
  198. proc containsSpace { cmd } { return [string match "*\[ \t\]*" $cmd] }
  199. proc containsReturn { cmd } { return [string match "*\[\r\n\]*" $cmd] }
  200.  
  201. ## 
  202.  # -------------------------------------------------------------------------
  203.  #     
  204.  #    "findPatJustBefore"    --
  205.  #    
  206.  #     Utility proc to check whether the first occurrence    of 'findpat'
  207.  #     to    the    left of    'pos' is actually an occurrence    of 'pat'. It can
  208.  #     be    used to    check if we're part    of an '} else {' (see TclelectricLeft)
  209.  #     or    in TeX mode    if we're in    the    argument of    a '\label{'    or '\ref{'
  210.  #     (see smartScripts)    for    example.
  211.  #     
  212.  #     A typical usage has the regexp    'pat' end in '$', so that it must
  213.  #     match all the text    up to 'pos'.  'matchw' can be used to store
  214.  #     the first '()'    pair match in the regexp.
  215.  #     
  216.  #     New: maxlook restricts how far this proc will search.  The default
  217.  #     is only 100 (not the entire file), after all this proc is supposed
  218.  #     to look 'just before'!
  219.  # -------------------------------------------------------------------------
  220.  ##
  221. proc findPatJustBefore { findpat pat {pos ""} {matchw ""} {maxlook 100} } {
  222.     if { $pos == "" } {set pos [getPos] }
  223.     if { $pos == [maxPos]} { set pos [pos::math $pos - 1]}
  224.     if { $matchw != "" } { upvar $matchw word }
  225.     if {[llength [set res [search -s -n -f 0 -r 1 -l [pos::math $pos - $maxlook] -- "$findpat" $pos]]]} {
  226.     if {[regexp "$pat" [getText [lindex $res 0] $pos] dum word]} {
  227.         return [lindex $res 0]
  228.     }
  229.     }
  230.     return
  231. }
  232. # Look for pattern in filename after position afterPos and, if found, 
  233. # open the file quietly and select the pattern
  234. # author Jonathan Guyer
  235. proc selectPatternInFile {filename pattern {afterPos ""}} {
  236.     if {$afterPos == ""} {set afterPos [minPos]}
  237.     set searchResult [searchInFile $filename $pattern 1]
  238.     if {[pos::compare [lindex $searchResult 0] >= $afterPos]} {
  239.     placeBookmark
  240.     file::openQuietly $filename
  241.     eval select $searchResult
  242.     message "press <Ctl .> to return to original cursor position"
  243.     return 1
  244.     } else {
  245.     return 0
  246.     }
  247. }
  248.  
  249. proc text::replace {old new {fwd 1} {pos ""}} {
  250.     if {$pos == ""} {set pos [getPos]}
  251.     set m [search -s -f $fwd -m 0 -r 0 -- $old $pos]
  252.     eval replaceText $m [list $new]
  253. }
  254.  
  255. proc isSelection {} {
  256.     return [pos::compare [getPos] != [selEnd]]
  257. }
  258. proc searchStart {} {
  259.     global search_start
  260.     select [getPos]
  261.     setMark
  262.     if {[catch {goto $search_start}]} {message "No previous search"}
  263. }
  264. set {patternLibrary(Pascal to C Comments)}      { {\{([^\}]*)\}}    {/* \1 */}     }
  265. set {patternLibrary(C++ to C Comments)}            { {//(.*)}            {/* \1 */}     }
  266. set {patternLibrary(Space Runs to Tabs)}        { { +}                {\t}         }
  267.  
  268. proc getPatternLibrary {} {
  269.     global patternLibrary
  270.     
  271.     foreach nm [array names patternLibrary] {
  272.     lappend nms [concat [list $nm] $patternLibrary($nm)]
  273.     }
  274.     return $nms
  275. }
  276.  
  277. # This fails if, say, search string is '\{[^}]'
  278. # This is because the '}' ends the first argument because this
  279. # procedure is presumably called internally with incorrect quoting.
  280. proc rememberPatternHook {search replace} {
  281.     global patternLibrary modifiedArrayElements
  282.     if {[catch {set name [prompt "New pattern's name?" ""]}]} {
  283.     return ""
  284.     }
  285.     lappend modifiedArrayElements [list $name patternLibrary]
  286.     set patternLibrary($name) [list $search $replace]
  287.     return $name
  288. }
  289.  
  290. proc deletePatternHook {} {
  291.     global patternLibrary modifiedArrayElements
  292.     set temp [list prompt "Delete which pattern?" [lindex [array names patternLibrary] 0] "Pats:"]
  293.     set name [eval [concat $temp [array names patternLibrary]]]
  294.     lappend modifiedArrayElements [list $name patternLibrary]
  295.     unset patternLibrary($name)
  296. }
  297.  
  298. ## 
  299.  # -------------------------------------------------------------------------
  300.  # 
  301.  # "regIsearch" -- REGular expression Iterative SEARCH
  302.  # 
  303.  # This version allows class shorthands (\d \s \w \D \S \W), 
  304.  # word anchors (\b), and some aliases of the machine dependent 
  305.  # control characters (\a \f \e \n \r \t). Therefore, 
  306.  # we need two prompts, one for when we have a valid pattern, and one 
  307.  # for when the pattern has gone invalid (most likely due to starting 
  308.  # to enter one of the above patterns). 
  309.  # 
  310.  # The Return key aborts it  and the point goes back to the 
  311.  # original $pos. You can then use 'exchangePointAndMark' 
  312.  # (cntrl-x, cntrl-x -in emacs keyset) to jump back and forth 
  313.  # between where the search started from, to where the search was
  314.  # ended.
  315.  # 
  316.  # The Escape key or Mouse-click "exits" it, (as does "abortEm" -bound 
  317.  # to cntrl-g), as well as most modifier-key-combinations
  318.  # (except for Shift, and any combination whose  binding's 
  319.  # functionality makes sense -see regComp below). Also the 
  320.  # up & down Arrow keys, exit it. An exit differs from an abort in that, 
  321.  # in the former, the selection is left at the last search result.
  322.  # 
  323.  # 
  324.  # The next occurrence of the current pattern can be matched by typing 
  325.  # either control-s (to get the next occurence forward), or control-r 
  326.  # (to get the the next occurrence backward)
  327.  #
  328.  # Also, after aborting, the search string is left in the Find dialog,
  329.  # and so you can use 'findAgain', but, be aware that the Find dialog
  330.  # starts out with a default of <Grep=OFF>.
  331.  #  
  332.  # Original Author: Mark Nagata
  333.  # modifications  : Tom Fetherston
  334.  # -------------------------------------------------------------------------
  335.  ##
  336. proc regIsearch {} {
  337.     
  338.     set ignoreCase 0
  339.     set patt ""
  340.     set pos [getPos]
  341.     
  342.     set done 0
  343.     while {!$done} {
  344.     # check pattern validatity
  345.     if {[catch {regexp -- $patt {} dmy} dmy]} {        
  346.         set prompt "building->: $patt"
  347.     } else {
  348.         set prompt "regIsearch: $patt"
  349.     } 
  350.     switch -- [catch {status::prompt $prompt regComp "anything"} res] {
  351.         0 {
  352.         # got a keystroke that triggered a normal end (e.g. <return>)
  353.         goto $pos
  354.         message "Aborted: $patt"
  355.         return
  356.         }
  357.         1 {
  358.         # an error was generated
  359.         if {[string match "missing close-brace" $res]} {
  360.             # must have typed a slash, so:
  361.             append patt "\\"
  362.             continue
  363.         } else {
  364.             # alertnote $res
  365.             set done 1
  366.         }
  367.         
  368.         }
  369.         default {
  370.         set done 1
  371.         }
  372.     }
  373.     
  374.     }
  375.     
  376.     message " Exited: $patt"
  377. }
  378.  
  379.  
  380. ## 
  381.  # -------------------------------------------------------------------------
  382.  # 
  383.  # "regComp" -- REGisearch COMmand line input character Processor
  384.  # 
  385.  #  This proc handles each keypress while running a regIsearch. It has been 
  386.  #  modified from Mark Nagata's original to provide next ocurrence 
  387.  #  before/after current, and support for key bindings whose navigation or 
  388.  #  text manipulation functionality makes sense with respect to a regIsearch.
  389.  #  
  390.  #  closest occurence before current match    
  391.  #    - command-option g & cntrl-r (mnemonic 'reverse')
  392.  #  closest occurence after current match
  393.  #    - command g & cntrl-s (mnemonic 'successor')
  394.  #  
  395.  #                         Text Naviagation
  396.  #  forwardChar (aborts and leaves cursor after last match)
  397.  #    - right arrow & cntrl-f (emacs)
  398.  #  backwardChar (aborts and leaves cursor before last match)
  399.  #    - left arrow & cntrl-b (emacs)
  400.  #  beginningOfLine (aborts and moves cursors to the start of the line 
  401.  #      containing the last match)
  402.  #    - cmd left arrow & cntrl-a (emacs)
  403.  #  beginningOfLine (aborts and moves cursors to the start of the line 
  404.  #      containing the last match)
  405.  #    - cmd right arrow & cntrl-e (emacs)
  406.  #  
  407.  #                         Text Manipulation
  408.  #  deleteSelection (aborts and deletes selection)
  409.  #    - cntrl-d (emacs)
  410.  #  killLine (aborts and deletes from start of selection to end of line)
  411.  #    - cntrl-k (emacs)
  412.  #  
  413.  # -------------------------------------------------------------------------
  414.  ##
  415. proc regComp {curr {key 0} {mod 0}} {
  416.     set direction {}
  417.     
  418.     # build a string that represents all the modifiers pressed:
  419.     # checking in this order cmd, shift, option, and ctrl
  420.     if {[expr {$mod & 1}]} { append t "c" } else { append t "_" }
  421.     if {[expr {$mod & 34}]} { append t "s" } else { append t "_" }
  422.     if {[expr {$mod & 72}]} { append t "o" } else { append t "_" }
  423.     if {[expr {$mod & 144}]} { append t "z" } else { append t "_" }
  424.     
  425.     scan $key %c decVal
  426.     
  427.     switch -- $t {
  428.     "____" {
  429.         switch -- $decVal {
  430.         29 {forwardChar ;         break; # right arrow; }
  431.         28 {backwardChar ;         break; # left arrow; }
  432.         30 {                        break; # up arrow; }
  433.         31 {                        break; # down arrow; }
  434.         }
  435.     }
  436.     }
  437.     
  438.     switch -- $t {
  439.     "____" - 
  440.     "_s__" {
  441.         upvar patt pat
  442.         if {$curr != ""} {
  443.         while {[string compare [string range $pat [string last $curr $pat] end] $curr] != 0} {
  444.             set newEnd [expr {[string length $pat] - 2}]
  445.             if {$newEnd < 0} {
  446.             error "deleted past string start"
  447.             } 
  448.             set pat [string range $pat 0 $newEnd] 
  449.         }
  450.         } 
  451.         
  452.         set preAppend $pat
  453.         append pat $key
  454.         if {[catch {regexp $pat {} dmy} res]} {
  455.         message "building->: $preAppend"
  456.         } else {
  457.         message "regIsearch: $preAppend" 
  458.         upvar ignoreCase ign
  459.         set searchResult [search -n -f 1 -m 0 -i $ign -r 1 -- $pat [getPos]]
  460.         if {[llength $searchResult] == 0} {
  461.             beep
  462.         } else {
  463.             select [lindex $searchResult 0] [lindex $searchResult 1]
  464.         }
  465.         } 
  466.         return $key
  467.         
  468.     }
  469.     "c___" {
  470.         switch -- $decVal {
  471.         103 { set direction fwd;        # (cmd g); }
  472.         28 {beginningOfLine ;     break; # cmd left arrow; }
  473.         29 {endOfLine ;         break; # cmd right arrow; }
  474.         }
  475.         
  476.     }
  477.     "___z" {
  478.         # If the user is using the emacs key bindings, check for ones that 
  479.         # make sense. All other control key combinations abort
  480.         if {[package::active emacs]} {
  481.         switch -- $decVal {
  482.             6 {forwardChar ;         break; # cntrl-f; }
  483.             2 {backwardChar ;     break; # cntrl-b; }
  484.             1 {beginningOfLine ;     break; # cntrl-a; }
  485.             5 {endOfLine ;         break; # cntrl-e; }
  486.             4 {deleteSelection ;     break; # cntrl-d; }
  487.             10 {killLine ;         break; # cntrl-k; }
  488.         }
  489.         } 
  490.         # See if user has requested to find another match, either searchForward 
  491.         # (cntrl-s) or reverseSearch (cntrl-r). Set flag accordingly
  492.         switch -- $decVal {
  493.         115 - 19 { set direction fwd; # (cntrl-s); }
  494.         114 - 18 { set direction bckwd; # (cntrl-r); }
  495.         default {return {} }
  496.         }
  497.     }
  498.     "c_o_" {
  499.         switch $decVal {
  500.         169 { set direction bckwd; # (cmd-opt 'g'); }
  501.         default {return {} }
  502.         }
  503.         
  504.     }
  505.     "default" {
  506.         beep
  507.         error "modifier combination has no meaningful bindings with respect to regIsearch"
  508.     }
  509.     }
  510.     # handle direction flag if it got set above
  511.     if {$direction != ""} {
  512.     upvar patt pat
  513.     upvar ignoreCase ign
  514.     if {[string match $direction fwd]} {
  515.         set dir 1
  516.         set search_start [pos::math [getPos] + 1]
  517.     } else {
  518.         set dir 0
  519.         set search_start [pos::math [getPos] - 1]
  520.     } 
  521.     set searchResult [search -n -f $dir -m 0 -i $ign -r 1 -- $pat $search_start]
  522.     if {[llength $searchResult] == 0} {
  523.         beep
  524.     } else {
  525.         select [lindex $searchResult 0] [lindex $searchResult 1]
  526.     }
  527.     return {}
  528.     } 
  529. }
  530.  
  531.  
  532. proc choicesProc {curr c} {
  533.     global choiceList
  534.     if {$c != "\t"} {return $c}
  535.     
  536.     set matches {}
  537.     foreach w $choiceList {
  538.         if {[string match "$curr*" $w]} {
  539.             lappend matches $w
  540.         }
  541.     }
  542.     if {![llength $matches]} {
  543.         beep
  544.     } else {
  545.         return [string range [largestPrefix $matches] [string length $curr] end]
  546.     }
  547.     return ""
  548. }
  549.  
  550.  
  551. proc sPromptChoices {msg def choiceListIn} {
  552.     global useStatusBar choiceList
  553.     set choiceList $choiceListIn
  554.     if {[catch {statusPrompt -f "$msg ($def): " choicesProc} ans]} {
  555.     error "cancel"
  556.     }
  557.     if {![string length $ans]} {return $def}
  558.     return $ans
  559. }
  560.  
  561. proc nextFunc {} {
  562.     searchFunc 1
  563. }
  564.  
  565. proc prevFunc {} {
  566.     searchFunc 0
  567. }
  568.  
  569. proc jumpNextFunc {} {
  570.     searchFunc 3
  571. }
  572.  
  573. proc jumpPrevFunc {} {
  574.     searchFunc 2
  575. }
  576.  
  577. proc searchFunc {code} {
  578.     set pos [getPos]
  579.     
  580.     #to allow us to handle special cases
  581.     set funcExpr [get_funcExpr $code]
  582.     
  583.     select $pos
  584.     
  585.     switch $code {
  586.       "1" -
  587.       "3" {
  588.         set pos [pos::math $pos + 1]
  589.         set lastStop [maxPos]
  590.         set dir 1
  591.       }
  592.       "0" -
  593.       "2" {
  594.         set pos [pos::math $pos - 1]
  595.         set lastStop 0
  596.         set dir 0
  597.       }
  598.     }
  599.  
  600.     if {![catch {search -s -f $dir -i 1 -r 1 -- $funcExpr $pos} res]} {
  601.         eval select $res
  602.     } elseif {$code == 3} {
  603.         searchFunc 1
  604.     } else {
  605.         goto $lastStop
  606.         switch $dir {
  607.         0 {
  608.         message "At top, no more functions in this direction"
  609.         }
  610.         1 {
  611.         message "At bottom, no more functions in this direction"
  612.         }
  613.     }
  614.     }
  615. }
  616.  
  617. proc get_funcExpr {dir} {
  618.     global funcExpr mode
  619.     switch $mode {
  620.       "Tcl" {
  621.         if {[regexp "^\\* Trace" [win::CurrentTail]]} {
  622.             switch $dir {
  623.               "0" -
  624.               "1" {
  625.                 set searchExpr {(^ *[\w:]+ $)|(^ *[^ ']+ ')}
  626.               }
  627.               "2" {
  628.                 if {[regexp {(^.*)OK:} [getSelect] blah searchExpr]} {
  629.                     set searchExpr "^${searchExpr}"
  630.                 } else {
  631.                     set searchExpr {(^ *[\w:]+ $)|(^ *[^ ']+ ')}
  632.                 }
  633.               }
  634.               "3" {
  635.                 regexp {(^[^']*)'?} [getSelect] blah searchExpr
  636.                 set searchExpr "^${searchExpr}OK:"
  637.               }
  638.             }
  639.         } else {
  640.             set searchExpr $funcExpr 
  641.         } 
  642.       }
  643.       "default" {
  644.         set searchExpr $funcExpr 
  645.       }
  646.     }
  647.     return $searchExpr     
  648. }
  649.  
  650. proc sPrompt {msg def} {
  651.     global useStatusBar
  652.     if {!$useStatusBar} {return [prompt $msg $def]}
  653.     if {[catch {statusPrompt "$msg ($def): "} ans]} {
  654.         error "cancel"
  655.     }
  656.     if {![string length $ans]} {return $def}
  657.     return $ans
  658. }
  659.  
  660. ###
  661. #===========================================================================
  662. # Juan Falgueras (7/Abril/93)
  663. # you only need to select (or not) text and move *forward and backward*
  664. # faster than iSearch (if you have there the |word wo|rd..).
  665. #===========================================================================
  666.  
  667. proc quickSearch {dir} {
  668.     if {[pos::compare [selEnd] == [getPos]]} {
  669.         backwardChar
  670.         hiliteWord
  671.     }
  672.     set myPos [expr {$dir ? [selEnd] : [pos::math [getPos] - 1]}]
  673.     set text [getSelect]
  674.     set searchResult [search -s -n -f $dir -m 0 -i 1 -r 0 $text $myPos]
  675.     if {[llength $searchResult] == 0} {
  676.         beep
  677.         message [concat [expr {$dir ? "->" : "<-"}] '$text' " not found"]
  678.         return 0
  679.     } else {
  680.         message [concat [expr {$dir ? "->" : "<-"}] '$text']
  681.         eval select $searchResult
  682.         return 1
  683.     }
  684. }
  685.  
  686.